home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / WINDOWS / PPW1.ARJ / HOST.WAS < prev    next >
Text File  |  1992-06-18  |  38KB  |  1,117 lines
  1. ;Host Mode script v1.00a
  2.  
  3. ;***********************************************************************
  4. ;*                                                                     *   
  5. ;* HOST.WAS                                                            *
  6. ;* Copyright (C) 1992 Datastorm Technologies, Inc.                     *     
  7. ;* All rights reserverd.                                               * 
  8. ;*                                                                     * 
  9. ;* Purpose: Provides an interface for a remote user to send and        *
  10. ;*          receive files and electronic mail.                         *
  11. ;*                                                                     * 
  12. ;***********************************************************************
  13.  
  14. ;***********************************************************************
  15. ;*                                                                     *
  16. ;*  WARNING!!!!                                                        *
  17. ;*                                                                     *
  18. ;*  Do not modify this script file unless you have a good under-       *
  19. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  20. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  21. ;*                                                                     *
  22. ;***********************************************************************
  23.  
  24. ;***********************************************************************
  25. ;*                                                                     *
  26. ;*   MACRO DEFINITIONS                                                 *
  27. ;*                                                                     *
  28. ;***********************************************************************
  29. #define FALSE 0         ; Boolean variables
  30. #define TRUE  1         ;
  31.  
  32. #define NAMEMAX 30      ; maximum length for user name
  33. #define PSWDMAX 8       ; maximum user passwrd length
  34.  
  35. #define DISP 1          ; show characters for input
  36. #define MASK 0          ; hide characters for password input
  37.  
  38. #define MODEM_CON    0  ; Connection type is a MODEM
  39. #define DIRECT_CON   1  ; Connection type is direct cable / no MODEM
  40.  
  41. #define OPEN_SYSTEM   0 ; anyone can login
  42. #define CLOSED_SYSTEM 1 ; only users already in the HOST.USR can login
  43.  
  44. ; access_level levels for users
  45. #define NEWUSER      0  ; new - can't do file xfers
  46. #define REGUSER      1  ; normal-can do file xfers to upload/download areas
  47. #define SUPERUSER    2  ; super-can do file xfers to/from any drive/directory
  48.  
  49. #define FLD_SEP    59   ; Field separator is ACSII 59 (semi-colon)
  50.  
  51. #define HOSTUSRFILE  "HOST.USR" ; User data file
  52. #define HOSTLOGFILE  "HOST.LOG" ; Log of Host activity
  53. #define HOSTPRMFILE  "HOST.PRM" ; Parameter file
  54. #define HOSTHLPFILE  "HOST.HLP" ; Help file
  55. #define HOSTNWSFILE  "HOST.NWS" ; News file
  56. #define HOSTNUFILE   "HOST.NUF" ; New user file
  57. #define HOSTDNLDFILE "HOST.DNL" ; Download file list
  58.  
  59. ;Mail Defines
  60. #define HOSTMSGFILE  "HOST.MSG" ; Mail message file
  61. #define HOSTHDRFILE  "HOST.HDR" ; Mail header file
  62. #define PUBLIC     0    ; Mail message flags
  63. #define PRIVATE    1    ;
  64. #define NEWMAIL    2    ;
  65. #define DELETED    4    ;
  66.  
  67. ;***********************************************************************
  68. ;*                                                                     *
  69. ;*   GLOBAL VARIABLES                                                  *
  70. ;*                                                                     *
  71. ;***********************************************************************
  72. string welcome_msg, upload_path, dnload_path, ontime, offtime
  73. string record, name, first, last, passwrd, access_level, remarks, msg
  74. string logfile, parmfile, usrfile, newsfile, hlpfile, dnldfile
  75. string nufile, _time, _date, message, searchstr
  76. string hdrfile, msgfile, tempfile
  77. integer new_usr_level, connect_type, system_type, goodbye_option
  78. integer old_menu, new_menu, tempkey, status, msg_number
  79. integer action_status, dial_status, setup_status, meta_status
  80. integer local_logon, jump, sysop, already_saved
  81.  
  82. ;***********************************************************************
  83. ;*                                                                     *   
  84. ;* MAIN                                                                *
  85. ;*                                                                     *
  86. ;* This is the main program loop.                                      *
  87. ;*                                                                     *
  88. ;* Calls: SAVE_PRM, HOSTSETUP, HOSTLOG, WAITFORCALL,  GETUSER,         *
  89. ;*        DISPLAYFILE, CHECKMAIL, HOSTMENU                             *
  90. ;*                                                                     *
  91. ;* Modifies globals: action_status, meta_status, dial_status, name,    *
  92. ;*                   setup_status, jump, local_logon, new_menu, sysop, *
  93. ;*                   connect_type, newsfile, msg, access_level,        *
  94. ;*                   parmfile                                          *
  95. ;*                                                                     *
  96. ;***********************************************************************
  97. #include "SUBS.WAS"             ;host subroutine library
  98. #include "MAIL.WAS"             ;host mail routines
  99.  
  100. proc main
  101.  
  102.    set aspect spawn on                 ; allow spawning of scripts
  103.    fetch aspect scriptpath parmfile    ; build a path to the HOST.PRM
  104.    addfilename parmfile HOSTPRMFILE
  105.  
  106.    if not isfile parmfile              ; if the .PRM doesn't exist
  107.       execute "HOSTUTIL"               ; run HOSTUTIL.WAS
  108.    endif
  109.                                        ; get the status of the
  110.    action_status=$ACTIONBAR            ; programs modeless windows
  111.    meta_status=$METAKEYS
  112.    dial_status=$DIALDIR
  113.    setup_status=$SETUP
  114.    if action_status                    ; if action bar is on
  115.       actionbar off                    ;  turn it off
  116.     endif
  117.    if meta_status                      ; if metakeys are on
  118.       metakeys off                     ;  turn them off
  119.    endif
  120.  
  121.    if dial_status                      ; if dialing directory is on
  122.       dialdir off                      ;  turn it off
  123.    endif
  124.  
  125.    if setup_status                     ; if setup is on
  126.       setup off                        ;  turn it off
  127.    endif
  128.  
  129.    already_saved=0
  130.    
  131.    while 1
  132.       statmsg " "
  133.       setjmp 1 jump
  134.       HostSetup()            ; set system variables and open HOST.PRM
  135.       HostLog("Host mode online.", "")
  136.       pwtitlebar "PROCOMM PLUS for Windows - Host Mode"
  137.       WaitForCall()
  138.  
  139.       if local_logon
  140.          menuitem new_menu 3 "&Recycle!"
  141.          showmenu new_menu
  142.       else
  143.          enable menu 2
  144.       endif
  145.  
  146.       menuitem new_menu 4 "E&xit Host!"
  147.       showmenu new_menu
  148.  
  149.       if !sysop
  150.          GetUser()               ; Wait for someone to login
  151.          if success              ; If user logged on,
  152.             if (! $carrier) && (connect_type==MODEM_CON)
  153.                HostLog("Lost Carrier.", "")
  154.                loopwhile
  155.             endif
  156.             DisplayFile(newsfile, 23)
  157.             strfmt msg "Remote user %s online" name
  158.             pwtitlebar msg
  159.             if local_logon
  160.                HostLog(name, "logged in locally.")
  161.             else
  162.                HostLog(name, "logged in.")
  163.             endif
  164.             CheckMail()
  165.             HostMenu()
  166.          endif
  167.       else
  168.          name = "SYSOP"
  169.          access_level="2"
  170.          time ontime
  171.          CheckMail()
  172.          HostMenu()
  173.       endif
  174.    endwhile
  175. endproc
  176.  
  177. ;***********************************************************************
  178. ;*                                                                     *   
  179. ;* HOSTMENU                                                            *
  180. ;*                                                                     *
  181. ;* This procedure is the main menu for the remote user.                *
  182. ;*                                                                     *
  183. ;*                                                                     * 
  184. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, DISPLAYFILE,        *
  185. ;*        FILELIST, UPLOAD, DOWNLOAD, CHAT, READMAIL, LEAVEMAIL,       *
  186. ;*        HOSTHANGUP, EXITHOST, HOSTGETYN, RESTORE_PRM, SWITCHDIR      *
  187. ;*                                                                     *
  188. ;* Modifies globals: access_level, connect_type, dnldfile, local_logon,*
  189. ;*                   hlpfile, offtime, ontime, goodbye_option, name,   *
  190. ;*                   action_status, meta_status,  dial_status,         *
  191. ;*                   setup_status                                      *
  192. ;*                                                                     *
  193. ;***********************************************************************
  194. proc HostMenu
  195. integer security
  196. string key, auto_ans_off
  197.    ;convert access_level level into an integer
  198.    atoi access_level security
  199.  
  200.    set txpace 0
  201.    while 1
  202.       HostPutS("`r`n")
  203.       HostPutS("`r`nF)iles      U)pload      D)ownload")
  204.       HostPutS("`r`nH)elp       T)ime        C)hat")
  205.       HostPutS("`r`nR)ead mail  L)eave mail  G)oodbye")
  206.  
  207.       if security==2
  208.          HostPutS("`r`n`r`nS)witch directory")
  209.          HostPutS("`r`nA)bort (SHUT DOWN host mode)")
  210.       endif
  211.  
  212.       HostPutS("`r`n`r`nYour Choice? ")
  213.  
  214.       if (! $carrier) && (connect_type==MODEM_CON)
  215.          HostLog("Lost Carrier", "")
  216.          SetFailure()
  217.          exitwhile
  218.       endif
  219.  
  220.       HostGetC(&key)
  221.       if failure
  222.          exitwhile
  223.       endif
  224.  
  225.       HostPutS(key)
  226.  
  227.       switch key
  228. ;****************
  229. ;* F)iles       *
  230. ;****************
  231.          case "F"
  232.             if security!=2
  233.                fetch aspect scriptpath dnldfile
  234.                addfilename dnldfile HOSTDNLDFILE
  235.                DisplayFile(dnldfile, 23)
  236.                if not success
  237.                   FileList()
  238.                endif
  239.             else
  240.                FileList()
  241.             endif
  242.          endcase
  243. ;****************
  244. ;* U)pload      *
  245. ;****************
  246.          case "U"
  247.             if local_logon
  248.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  249.             else
  250.                if security==0
  251.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  252.                else
  253.                   Upload()
  254.                endif
  255.             endif
  256.          endcase
  257. ;****************
  258. ;* D)ownload    *
  259. ;****************
  260.          case "D"
  261.             if local_logon
  262.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  263.             else
  264.                if security==0
  265.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  266.                else
  267.                   Download()
  268.                endif
  269.             endif
  270.          endcase
  271. ;****************
  272. ;* H)elp        *
  273. ;****************
  274.          case "H"
  275.             fetch aspect scriptpath hlpfile
  276.             addfilename hlpfile HOSTHLPFILE
  277.             DisplayFile(hlpfile, 23)
  278.             if not success
  279.                HostPutS("`r`nHelp not available.`r`n")
  280.             endif
  281.          endcase
  282. ;****************
  283. ;* T)ime        *
  284. ;****************
  285.          case "T"
  286.             time offtime
  287.             HostPutS("`r`n`r`nOnline at: ")
  288.             HostPutS(ontime)
  289.             HostPutS("`r`nIt is now: ")
  290.             HostPuts(offtime)
  291.             HostPutS("`r`n`r`n")
  292.          endcase
  293. ;****************
  294. ;* C)hat        *
  295. ;****************
  296.          case "C"
  297.             if local_logon
  298.                HostPutS("`r`n`r`nYou can't chat during a local logon!`r`n`r`n")
  299.             else
  300.                Chat()
  301.             endif
  302.          endcase
  303. ;****************
  304. ;* R)ead Mail   *
  305. ;****************
  306.          case "R"
  307.             ReadMail()
  308.          endcase
  309. ;****************
  310. ;* L)eave Mail  *
  311. ;****************
  312.          case "L"
  313.             LeaveMail(0,"", "")
  314.          endcase
  315. ;****************
  316. ;* G)oodbye     *
  317. ;****************
  318.          case "G"                                ;Goodbye
  319.             time offtime
  320.             HostPutS("`r`n`r`nOnline at: ")
  321.             HostPutS(ontime)
  322.             HostPutS("`r`nIt is now: ")
  323.             HostPuts(offtime)
  324.             HostPutS("`r`n`r`n")
  325.                 
  326.             if connect_type==MODEM_CON
  327.                HostHangup()
  328.             endif
  329.             if goodbye_option==1
  330.                clear
  331.                ExitHost()
  332.             endif
  333.             HostLog(name, "logged out.")
  334.             exitwhile
  335.          endcase
  336. ;****************
  337. ; A)bort        *
  338. ;****************
  339.          case "A"
  340.             if security==2
  341.                HostPutS("`r`n`r`nAbort Host Mode (Y/N)?")
  342.                HostGetYN()
  343.                if success
  344.                   HostPutS("`r`nAborting ...`r`n")
  345.                   HostLog(name, "remote shutdown.")
  346.                   if connect_type==MODEM_CON
  347.                      HostPutS("`r`nHangup line (Y/N)?")
  348.                      HostGetYN()
  349.                      if success
  350.                         HostHangup()
  351.                         ; get modem auto answer string
  352.                         fetch modem autoansoff auto_ans_off   
  353.                         set txpace 50
  354.                         transmit auto_ans_off
  355.                         waitfor "OK" 5
  356.                         restore_prm()
  357.                      endif
  358.                   endif
  359.                   if action_status
  360.                      actionbar on
  361.                   endif
  362.                   if meta_status
  363.                      metakeys on
  364.                   endif
  365.                   if dial_status
  366.                      dialdir on
  367.                   endif
  368.                   if setup_status
  369.                      setup on
  370.                   endif
  371.                   clear
  372.                   statmsg " "
  373.                   pwtitlebar "PROCOMM PLUS for Windows"
  374.                   halt
  375.                endif
  376.             endif
  377.          endcase
  378. ;****************
  379. ; S)witch       *
  380. ;****************
  381.          case "S"
  382.             if security==2
  383.                SwitchDir()
  384.             endif
  385.          endcase
  386. ;***************
  387.       endswitch
  388.    endwhile
  389. endproc
  390.  
  391. ;***********************************************************************
  392. ;*                                                                     *   
  393. ;* FILELIST                                                            *
  394. ;*                                                                     *
  395. ;* This procedure displays a file directory for the user like the      *
  396. ;* DOS "DIR" command.                                                  *
  397. ;*                                                                     * 
  398. ;* Calls: HOSTPUTS, HOSTGETS, HOSTGETC                                 *
  399. ;*                                                                     *
  400. ;* Modifies globals: access_level, dnload_path,  msg                   *
  401. ;*                                                                     *
  402. ;***********************************************************************
  403. proc FileList
  404. string filespec, filepath, key, dirflag="<DIR>"
  405. integer security, again=0, linenum=1, maxlen=40
  406.     
  407.    atoi access_level security
  408.  
  409.    HostPutS("`r`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> ")
  410.    HostGetS(&filespec, maxlen, DISP)
  411.  
  412.    strcmp filespec ""
  413.    if success
  414.       filespec="*.*"
  415.    endif
  416.  
  417.    if security!=2
  418.       strcpy filepath dnload_path
  419.       addfilename filepath filespec
  420.    else
  421.       getdir 0 filepath
  422.       strfind filespec "\"
  423.       if not found
  424.          addfilename filepath filespec
  425.       else
  426.          strcpy filepath filespec
  427.       endif
  428.    endif
  429.  
  430.    findfirst filepath "D"
  431.    if found
  432.       strfind $FATTR "D"
  433.       if found
  434.          strfmt msg "`r`n`r`n %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  435.       else
  436.          strfmt msg "`r`n`r`n %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  437.       endif
  438.       HostPutS(msg)
  439.       linenum++
  440.       again=1
  441.    else
  442.       HostPutS("`r`n`r`nNo files found.`r`n")
  443.    endif
  444.    while again
  445.       if linenum==23
  446.          linenum=1
  447.          HostPutS("-MORE-")
  448.          HostGetC(&key)
  449.          HostPutS("`b`b`b`b`b`b")
  450.          strupr key
  451.          strcmp key "N"
  452.          if success
  453.             exitwhile
  454.          endif
  455.       endif
  456.  
  457.       findnext
  458.       if found
  459.          strfind $FATTR "D"
  460.          if found
  461.             strfmt msg " %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  462.          else
  463.             strfmt msg " %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  464.          endif
  465.          HostPutS(msg)
  466.          linenum++
  467.       else
  468.          HostPutS("`r`n-End of list.-`r`n")
  469.          exitwhile
  470.       endif
  471.    endwhile
  472. endproc
  473.  
  474. ;***********************************************************************
  475. ;*                                                                     *   
  476. ;* UPLOAD                                                              *
  477. ;*                                                                     *
  478. ;* This procedure provides a menu for the remote user to send files    *
  479. ;* to the host system.                                                 *
  480. ;*                                                                     * 
  481. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  482. ;*        ISWILDCARD, TXWAIT                                           *
  483. ;*                                                                     *
  484. ;* Modifies globals: connect_type, status, msg, name                   *
  485. ;*                                                                     *
  486. ;***********************************************************************
  487. proc upload
  488. string filename, choice
  489. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  490. integer calledfrom = 0
  491.  
  492.    while 1
  493.       HostPutS("`r`n")
  494.       HostPutS("`r`nK) Kermit      X) Xmodem")
  495.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  496.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  497.       HostPutS("`r`nZ) Zmodem")
  498.       HostPutS("`r`n")
  499.       HostPutS("`r`nYour choice? ")
  500.  
  501.       if (! $carrier) && (connect_type==MODEM_CON)
  502.          HostLog("Lost Carrier", "")
  503.          SetFailure()
  504.          exitwhile
  505.       endif
  506.       HostGetC(&choice)
  507.       if failure
  508.          exitwhile
  509.       endif
  510.       HostPutS(choice)
  511.  
  512.       switch choice
  513. ;****************
  514. ;* K)ermit      *
  515. ;****************
  516.          case "K"
  517.             GetFname(&filename, calledfrom)
  518.             if failure
  519.                exitwhile
  520.             endif
  521.             HostPutS(xferbegin)
  522.             txwait()
  523.             getfile kermit
  524.          endcase
  525. ;****************
  526. ;* X)modem      *
  527. ;****************
  528.          case "X"
  529.             GetFname(&filename, calledfrom)
  530.             if failure
  531.                exitwhile
  532.             endif
  533.             IsWildcard(&filename)
  534.             if failure
  535.                exitwhile
  536.             endif
  537.             HostPutS(xferbegin)
  538.             txwait()
  539.             getfile xmodem filename
  540.          endcase
  541. ;****************
  542. ;* Z)modem      *
  543. ;****************
  544.          case "Z"
  545.             GetFname(&filename, calledfrom)
  546.             if failure
  547.                exitwhile
  548.             endif
  549.             HostPutS(xferbegin)
  550.             txwait()
  551.             getfile zmodem
  552.          endcase
  553. ;****************
  554. ;* Y)modem      *
  555. ;****************
  556.          case "Y"
  557.             GetFname(&filename, calledfrom)
  558.             if failure
  559.                exitwhile
  560.             endif
  561.             HostPutS(xferbegin)
  562.             txwait()
  563.             getfile ymodem
  564.          endcase
  565. ;****************
  566. ;* O) 1K Xmodem *
  567. ;****************
  568.          case "O"
  569.             GetFname(&filename, calledfrom)
  570.             if failure
  571.                exitwhile
  572.             endif
  573.             IsWildcard(&filename)
  574.             if failure
  575.                exitwhile
  576.             endif
  577.             HostPutS(xferbegin)
  578.             txwait()
  579.             getfile 1kxmodem filename
  580.          endcase
  581. ;****************
  582. ;* E) 1K XmodemG*
  583. ;****************
  584.          case "E"
  585.             GetFname(&filename, calledfrom)
  586.             if failure
  587.                exitwhile
  588.             endif
  589.             IsWildcard(&filename)
  590.             if failure
  591.                exitwhile
  592.             endif
  593.             HostPutS(xferbegin)
  594.             txwait()
  595.             getfile 1kxmodemg filename
  596.          endcase
  597. ;****************
  598. ;* Y)modem-G    *
  599. ;****************
  600.          case "G"
  601.             GetFname(&filename, calledfrom)
  602.             if failure
  603.                exitwhile
  604.             endif
  605.             HostPutS(xferbegin)
  606.             txwait()
  607.             getfile ymodemg
  608.          endcase
  609. ;****************
  610. ;* Default      *
  611. ;****************
  612.          default
  613.             exitwhile
  614.          endcase
  615.       endswitch
  616.  
  617.       pause 1
  618.  
  619.       status=$FILEXFER
  620.     
  621.       while status==1
  622.          ;loop here while xfer is going on
  623.          status=$FILEXFER
  624.       endwhile
  625.  
  626.       if status==2
  627.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  628.          strfmt msg "uploaded %s successfully." filename
  629.          HostLog(name, msg) ;log a sucessful upload
  630.       elseif status==3
  631.          ;log a failed upload
  632.          pause 2
  633.          rxflush
  634.          txflush
  635.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  636.          strfmt msg "failed to upload %s." filename
  637.          HostLog(name, msg) ;log a sucessful upload
  638.       endif
  639.       exitwhile
  640.    endwhile
  641. endproc
  642.  
  643. ;***********************************************************************
  644. ;*                                                                     *   
  645. ;* DOWNLOAD                                                            *
  646. ;*                                                                     *
  647. ;* This procedure provides a menu for the remote user to receive       *
  648. ;* files.                                                              *
  649. ;*                                                                     * 
  650. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  651. ;*        ISWILDCARD, TXWAIT                                           *
  652. ;*                                                                     *
  653. ;* Modifies globals: connect_type, status, msg, name                   *
  654. ;*                                                                     *
  655. ;***********************************************************************
  656. proc download
  657.  
  658. string filename, choice
  659. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  660. integer calledfrom = 1
  661.  
  662.    while 1
  663.       HostPutS("`r`n")
  664.       HostPutS("`r`nK) Kermit      X) Xmodem")
  665.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  666.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  667.       HostPutS("`r`nZ) Zmodem")
  668.       HostPutS("`r`n")
  669.       HostPutS("`r`nYour choice? ")
  670.  
  671.       if (! $carrier) && (connect_type==MODEM_CON)
  672.          HostLog("Lost Carrier", "")
  673.          SetFailure()
  674.          exitwhile
  675.       endif
  676.  
  677.       HostGetC(&choice)
  678.       if failure
  679.          exitwhile
  680.       endif
  681.  
  682.       HostPutS(choice)
  683.  
  684.       switch choice
  685. ;****************
  686. ;* K)ermit      *
  687. ;****************
  688.          case "K"
  689.             GetFname(&filename, calledfrom)
  690.             if failure
  691.                exitwhile
  692.             endif
  693.             HostPutS(xferbegin)
  694.             txwait()
  695.             sendfile kermit filename
  696.          endcase
  697. ;****************
  698. ;* X)modem      *
  699. ;****************
  700.          case "X"
  701.             GetFname(&filename, calledfrom)
  702.             if failure
  703.                exitwhile
  704.             endif
  705.             IsWildcard(&filename)
  706.             if failure
  707.                exitwhile
  708.             endif
  709.             HostPutS(xferbegin)
  710.             txwait()
  711.             sendfile xmodem filename
  712.          endcase
  713. ;****************
  714. ;* Z)modem      *
  715. ;****************
  716.          case "Z"
  717.             GetFname(&filename, calledfrom)
  718.             if failure
  719.                exitwhile
  720.             endif
  721.             HostPutS(xferbegin)
  722.             txwait()
  723.             sendfile zmodem filename
  724.          endcase
  725. ;****************
  726. ;* Y)modem      *
  727. ;****************
  728.          case "Y"
  729.             GetFname(&filename, calledfrom)
  730.             if failure
  731.                exitwhile
  732.             endif
  733.             HostPutS(xferbegin)
  734.             txwait()
  735.             sendfile ymodem filename
  736.          endcase
  737. ;****************
  738. ;* O) 1K Xmodem *
  739. ;****************
  740.          case "O"
  741.             GetFname(&filename, calledfrom)
  742.             if failure
  743.                exitwhile
  744.             endif
  745.             IsWildcard(&filename)
  746.             if failure
  747.                exitwhile
  748.             endif
  749.  
  750.             HostPutS(xferbegin)
  751.             txwait()
  752.             sendfile 1kxmodem filename
  753.          endcase
  754. ;****************
  755. ;* E) 1K XmodemG*
  756. ;****************
  757.          case "E"
  758.             GetFname(&filename, calledfrom)
  759.             if failure
  760.                exitwhile
  761.             endif
  762.             IsWildcard(&filename)
  763.             if failure
  764.                exitwhile
  765.             endif
  766.             HostPutS(xferbegin)
  767.             txwait()
  768.             sendfile 1kxmodemg filename
  769.          endcase
  770. ;****************
  771. ;* Y)modem-G    *
  772. ;****************
  773.          case "G"
  774.             GetFname(&filename, calledfrom)
  775.             if failure
  776.                exitwhile
  777.             endif
  778.             HostPutS(xferbegin)
  779.             txwait()
  780.             sendfile ymodemg filename
  781.          endcase
  782. ;****************
  783. ;* Default      *
  784. ;****************
  785.          default
  786.             exitwhile
  787.          endcase
  788.       endswitch
  789.  
  790.       pause 1
  791.  
  792.       status=$FILEXFER
  793.     
  794.       while status==1
  795.          ;loop here while xfer is going on
  796.          status=$FILEXFER
  797.       endwhile
  798.         
  799.       rxflush
  800.       txflush
  801.       pause 1
  802.         
  803.       if status==2
  804.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  805.          strfmt msg "downloaded %s successfully." filename
  806.          HostLog(name, msg) ;log a sucessful download
  807.       elseif status==3
  808.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  809.          strfmt msg "failed to download %s." filename
  810.          HostLog(name, msg) ;log a sucessful download
  811.       endif
  812.       exitwhile
  813.    endwhile
  814. endproc
  815.  
  816. ;***********************************************************************
  817. ;*                                                                     *   
  818. ;* GETFNAME                                                            *
  819. ;*                                                                     *
  820. ;* This procedure validates a filename for upload or download.         *
  821. ;*                                                                     *
  822. ;* Input:  string fname (filename to be validated)                     *
  823. ;*         integer calledfrom (upload or download menu)                *
  824. ;*                                                                     *
  825. ;* Return:  Success for vaild filename, Failure on invalid filename    *
  826. ;*                                                                     *
  827. ;*                                                                     *
  828. ;* Notes:  Keeps level 1 users from downloading any file they want     *
  829. ;*                                                                     *
  830. ;* Calls: HOSTPUTS, HOSTGETS, SETFAILURE, SETSUCCESS, HOSTGETYN        *                                                     *
  831. ;*                                                                     *
  832. ;* Modifies globals: dnload_path,  access_level, msg                   *
  833. ;*                                                                     *
  834. ;*                                                                     *
  835. ;***********************************************************************
  836. proc GetFname
  837. strparm fname
  838. intparm calledfrom
  839. string filepath
  840. integer security, length
  841.  
  842.  
  843.    if calledfrom==0              ; user is uploading
  844.       filepath=upload_path
  845.    else
  846.       filepath=dnload_path       ; user is downloading
  847.    endif
  848.  
  849.    atoi access_level security
  850.  
  851.    HostPutS("`r`n`r`nFile name? ")
  852.  
  853.    HostGetS(&fname, 50, DISP)    ; get the filename
  854.    if failure
  855.       SetFailure()
  856.       return
  857.    endif
  858.  
  859.    strcmp fname ""               ; make sure user didn't hit
  860.    if success                    ; ENTER for the filename
  861.       SetFailure()
  862.       return
  863.    endif
  864.  
  865.    strlen fname length
  866.    if length>12
  867.       HostPutS("`r`nFilename is too long!`r`n`r`n")
  868.       SetFailure()
  869.       return
  870.    endif
  871.  
  872.    strupr fname                  ; uppercase the filename
  873.    HostPutS("`r`n")
  874.    if security!=2
  875.       strfind fname ":"          ; don't let regular users upload to
  876.       if found                   ; another drive
  877.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  878.          HostPutS(msg)
  879.          SetFailure()
  880.          return
  881.       endif
  882.  
  883.       strfind fname "\"          ; don't let regular users upload to
  884.       if found                   ; another path
  885.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  886.          HostPutS(msg)
  887.          SetFailure()
  888.          return
  889.       endif
  890.  
  891.       set dnldpath filepath
  892.       addfilename filepath fname ; build a fullpath for the filename
  893.       fname=filepath
  894.    else
  895.       getdir 0 filepath             ; level 2 users will upload to
  896.       set dnldpath filepath
  897.       addfilename filepath fname    ; the current directory
  898.       fname=filepath
  899.    endif
  900.  
  901.    findfirst fname                  ; find the file to see if it exist
  902.    if not found
  903.       if calledfrom == 1            ; if user is downloading
  904.          HostPutS("`r`nFile not found!`r`n")
  905.          SetFailure()
  906.          return
  907.       else
  908.          SetSuccess()
  909.          return
  910.       endif
  911.    else
  912.       if calledfrom == 0           ; user is uploading
  913.          if security !=2
  914.             HostPutS("`r`nFile already exists!`r`n")
  915.             SetFailure()
  916.             return
  917.          else
  918.             HostputS("`r`nFile exists, overwrite? ")
  919.             HostGetYN()
  920.             if success
  921.                HostPutS("`r`n")
  922.                delfile fname
  923.                if not success
  924.                   HostPutS("`r`n`r`nCan't delete file!`r`n")
  925.                   SetFailure()
  926.                   return
  927.                endif
  928.                SetSuccess()
  929.                return
  930.             else
  931.                SetFailure()
  932.                return
  933.             endif
  934.             HostPutS("`r`n")
  935.             SetFailure()
  936.             return
  937.          endif
  938.       endif
  939.       SetSuccess()
  940.    endif
  941.    HostPutS("`r`n")
  942. endproc
  943.  
  944. ;***********************************************************************
  945. ;*                                                                     *   
  946. ;* ISWILDCARD                                                          *
  947. ;*                                                                     *
  948. ;* This procedure keeps users from specifying wildcard characters in   *
  949. ;* a filename for transfer protocols that do no support them.          *
  950. ;*                                                                     *
  951. ;* Input:  string fname (filename to validate)                         *
  952. ;*                                                                     *
  953. ;* Return:  Success for valid filename, Failure otherwise              *
  954. ;*                                                                     * 
  955. ;* Calls: HOSTPUTS, SETFAILURE, SETSUCCESS                             *
  956. ;*                                                                     *
  957. ;* Modifies globals: none                                              *
  958. ;*                                                                     *
  959. ;***********************************************************************
  960. proc IsWildcard
  961. strparm fname
  962. string error = "`r`nNo wildcards allowed!`r`n"
  963.  
  964.    strfind fname "*"
  965.    if found
  966.       HostPutS(error)
  967.       SetFailure()
  968.       return
  969.    endif
  970.  
  971.    strfind fname "?"
  972.    if found
  973.       HostPutS(error)
  974.       SetFailure()
  975.       return
  976.    endif
  977.  
  978.    SetSuccess()
  979. endproc
  980.  
  981. ;***********************************************************************
  982. ;*                                                                     *   
  983. ;* SWITCHDIR                                                           *
  984. ;*                                                                     *
  985. ;* This procedure allows a level 2 user to change the working          *
  986. ;* directory                                                           *
  987. ;*                                                                     * 
  988. ;* Calls: HOSTPUTS, HOSTGETS, ISWILDCARD, HOSTLOG                      *
  989. ;*                                                                     *
  990. ;* Modifies globals: msg, name                                         *
  991. ;*                                                                     *
  992. ;***********************************************************************
  993. proc SwitchDir
  994. string filepath, newpath
  995.  
  996.    getdir 0 filepath
  997.    strfmt msg "`r`nCurrent directory is %s`r`n" filepath
  998.    HostPutS(msg)
  999.    HostPutS("Change to what directory? ")
  1000.    HostGetS(&newpath, 50, DISP)
  1001.    if success
  1002.       IsWildcard(newpath)
  1003.       HostPuts("`r`n")
  1004.       chdir newpath
  1005.       strfmt msg "changed directory to %s." newpath
  1006.       HostLog(name, msg)
  1007.       getdir 0 newpath
  1008.       strfmt msg "`r`nCurrent directory is now %s`r`n" newpath
  1009.       HostPuts(msg)
  1010.    endif
  1011. endproc
  1012.  
  1013. ;***********************************************************************
  1014. ;*                                                                     *   
  1015. ;* HOSTLOG                                                             *
  1016. ;*                                                                     *
  1017. ;* This procedure puts an activity message into the HOST.LOG file.     *
  1018. ;*                                                                     * 
  1019. ;* Calls: HOSTMSGBOX                                                   *
  1020. ;*                                                                     *
  1021. ;* Modifies globals: logfile, msg                                      *
  1022. ;*                                                                     *
  1023. ;***********************************************************************
  1024. proc HostLog
  1025. strparm activity1
  1026. strparm activity2
  1027.  
  1028.    isfile logfile
  1029.    if not success                       ;if new file put header at top
  1030.       fopen 1 logfile CREATE TEXT
  1031.       if success
  1032.          fputs 1 "  DATE      TIME             ACTIVITY"
  1033.          fputs 1 "--------  ----------   --------------------------------"
  1034.          fclose 1
  1035.       else
  1036.          HostMsgBox("Can't create HOST.LOG file!")
  1037.          return
  1038.       endif
  1039.    endif
  1040.         
  1041.    fopen 1 logfile WRITE TEXT
  1042.    if not success
  1043.       HostMsgBox("Can't open HOST.LOG file!")
  1044.       return
  1045.    endif
  1046.    fseek 1 0 2
  1047.    strfmt msg "%s  %s   %s %s" $DATE $TIME activity1 activity2
  1048.    fputs 1 msg
  1049.    fclose 1
  1050. endproc
  1051.  
  1052. ;***********************************************************************
  1053. ;*                                                                     *   
  1054. ;* SAVE_PRM                                                            *
  1055. ;*                                                                     *
  1056. ;* This procedure save_prm renames PW.PRM to PW.PRX and saves the      *
  1057. ;* current setup.                                                      *
  1058. ;*                                                                     * 
  1059. ;* Calls: nothing                                                      *
  1060. ;* Called by: MAIN                                                     *
  1061. ;* Modifies globals: none                                              *
  1062. ;*                                                                     *
  1063. ;***********************************************************************
  1064. proc save_prm
  1065. string prmfile
  1066. string oldprm="PW.PRM"
  1067. string newprm="PRM.BAK"
  1068.  
  1069.    if already_saved
  1070.       return
  1071.    endif
  1072.    already_saved=1   
  1073.    prmfile=$PWTASKPATH
  1074.    addfilename prmfile oldprm
  1075.    oldprm=prmfile
  1076.  
  1077.    prmfile=$PWTASKPATH
  1078.    addfilename prmfile newprm
  1079.    newprm=prmfile
  1080.    copyfile oldprm newprm
  1081.    savesetup
  1082. endproc
  1083.  
  1084. ;***********************************************************************
  1085. ;*                                                                     *   
  1086. ;* RESTORE_PRM                                                         *
  1087. ;*                                                                     *
  1088. ;* This procedure restore_prm restores the setup from disk and         *
  1089. ;* renames the PW.PRX file back to PW.PRM.                             *
  1090. ;*                                                                     * 
  1091. ;* Calls: NONE                                                         *
  1092. ;* Called by: ExitHost                                                 *
  1093. ;* Modifies globals: none                                              *
  1094. ;*                                                                     *
  1095. ;***********************************************************************
  1096. proc restore_prm
  1097. string prmfile
  1098. string oldprm="PW.PRM"
  1099. string newprm="PRM.BAK"
  1100.  
  1101.    restsetup
  1102.    prmfile=$PWTASKPATH
  1103.    addfilename prmfile oldprm
  1104.    oldprm=prmfile
  1105.  
  1106.    prmfile=$PWTASKPATH
  1107.    addfilename prmfile newprm
  1108.  
  1109.    newprm=prmfile
  1110.    delfile oldprm
  1111.    copyfile newprm oldprm
  1112.    isfile newprm
  1113.    delfile newprm
  1114. endproc
  1115.  
  1116. ;**** End of HOST.WAS ****
  1117.